home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).zip / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).adf / VideoText3.5 / source / VideoText.p < prev    next >
Text File  |  1994-04-01  |  8KB  |  253 lines
  1. PROGRAM VideoText;
  2. FROM vt USES global,sys,startup,jobs,bildschirm,datei;
  3. {$ulink "vt/s_i2cbusIO.o" }
  4. { Hauptprogramm/Ereignisverwaltung zum Projekt VideoText }
  5.  
  6. CONST version = '$VER: VideoText V3.5  (01.04.94)';
  7.  
  8. VAR l: Long;
  9.     testing: Boolean;
  10.     roundrobin, active: Byte;     { active: Summe der aktiven Jobs }
  11.     eingabe, s: Str80;
  12.     taste,ch: Char;
  13.     j: Integer;
  14.  
  15. PROCEDURE handle_key(key: char);
  16. { der Übersichtlichkeit halber aus dem Hauptprogramm herausgezogen }
  17. var j,ok,ft: integer;
  18.     s: String[20];
  19. begin
  20.   mainline;
  21.   case key of
  22.     '0'..'9','/': if length(eingabe) < 8 then
  23.         eingabe := eingabe + key;
  24.     #8: if length(eingabe) > 0 then
  25.         eingabe := copy(eingabe,1,length(eingabe)-1);
  26.     #13: begin
  27.         add_job(eingabe);
  28.         redraw_queue(-1);
  29.         eingabe := '';
  30.       end;
  31.     'x': begin
  32.         sleep;
  33.         mainline; write('Wirklich aufh|ren? ');
  34.         if ja_nein then stop := true;
  35.         wakeup;
  36.       end;
  37.     't': begin
  38.         testing := not testing;
  39.         if not testing then test(false);
  40.       end;
  41.     'i': begin
  42.           sleep; scanpages; redraw_all; wakeup;
  43.         end;
  44.     's': IF (thispage<>Nil) AND NOT protokoll THEN BEGIN
  45.         sleep;
  46.         fileinfo;
  47.         ft := filetype(outputname); mainline;
  48.         { Sicherheitsprüfungen: Überschreiben nur mit Bestätigung ... }
  49.         IF overwrite OR (AsciiRawIff=3) THEN BEGIN
  50.           IF ft<>-1 THEN BEGIN
  51.             write(']berschreiben - sicher? ');
  52.             IF NOT ja_nein THEN BEGIN  wakeup; exit;  END;
  53.           END;
  54.         { ... Anhängen nur an geeignete Dateien: }
  55.         END ELSE BEGIN
  56.           Write(#155'33m');
  57.           IF ft IN [2,3] THEN BEGIN
  58.             IF ft=2 THEN Write('Programmdatei') ELSE Write('IFF-Datei');
  59.             Write(', Anh{ngen unzul{ssig!');
  60.             wakeup; exit;
  61.           END;
  62.           IF (AsciiRawIff=2) AND NOT (ft IN [1,-1]) THEN BEGIN
  63.             Write('VT nur an VT-Format anh{ngen!');
  64.             wakeup; exit;
  65.           END;
  66.         END;
  67.         mainline; busy_pointer;
  68.         write('Seite ',thispage^.pg,'/',thispage^.sp,' ...');
  69.         if savepage(thispage,outputname) then
  70.           write(' gespeichert.')
  71.         else begin
  72.           mainline; Write(#155'33m');
  73.           write('Dateifehler - sorry!');
  74.         end;
  75.         normal_pointer;
  76.         wakeup;
  77.       end;
  78.     'n': BEGIN
  79.         sleep;
  80.         IF fileselect('Ausgabedatei festlegen',true,outputname) THEN;
  81.         cursoroff; { wurde von fileinfo evtl. eingeschaltet }
  82.         fileinfo;
  83.         wakeup;
  84.       END;
  85.     'f': IF NOT protokoll THEN BEGIN
  86.         AsciiRawIff := AsciiRawIff MOD 3 + 1;
  87.         fileinfo;
  88.       END;
  89.     'm': IF NOT protokoll AND (AsciiRawIff<>3) THEN BEGIN
  90.         overwrite := NOT overwrite;
  91.         fileinfo;
  92.       END;
  93.     'p': BEGIN
  94.         protokoll := NOT protokoll;
  95.         fileinfo; ft := filetype(outputname);
  96.         IF protokoll AND (ft IN [2,3]) THEN BEGIN
  97.           mainline; Write(#155'33m');
  98.           IF ft=2 THEN Write('Programm') ELSE Write('IFF');
  99.           Write(' nicht als Protokolldatei!')
  100.           protokoll := False; fileinfo;
  101.         END;
  102.       END;
  103.     #127: if thispage<>Nil then begin  { Del: eine Seite löschen }
  104.           del_from_list(thispage);
  105.           redraw_list;
  106.           writepage(Nil,true);
  107.         end;
  108.     { +/-: Jobauswahl markieren }
  109.     '+': IF thisjob>-queued THEN BEGIN
  110.           Dec(thisjob);
  111.           mark_queue(thisjob+1);
  112.           IF thisjob>=0 THEN BEGIN
  113.             aktspeicher := thisjob; display_select(aktspeicher); END;
  114.         END;
  115.     '-': IF thisjob<maxactive-1 THEN BEGIN
  116.           Inc(thisjob);
  117.           mark_queue(thisjob-1);
  118.           IF thisjob>=0 THEN BEGIN
  119.             aktspeicher := thisjob; display_select(aktspeicher); END;
  120.         END;
  121.     'u': IF thisjob>=0 THEN BEGIN  { einen Job zum Untertitel ernennen }
  122.           WITH activejobs[thisjob] DO
  123.             IF ist_UT=0 THEN ist_UT := $04 ELSE ist_UT := 0;
  124.           redraw_queue(thisjob);
  125.         END;
  126.     '*': begin { einen Job löschen }
  127.         if thisjob>=0 then begin
  128.           activejobs[thisjob].pg := 0;
  129.           sperren(thisjob);
  130.           redraw_queue(thisjob);
  131.         end;
  132.         if (thisjob<0) and (thisjob>=-queued) then begin
  133.           for j := -thisjob to queued-1 do
  134.             queue[j] := queue[j+1];
  135.           Dec(queued);
  136.           redraw_queue(-1);
  137.         end;
  138.       end;
  139.     ' ': writepage(thispage,true);
  140.     '?': writepage(thispage,false);
  141.     otherwise begin
  142.       mainline; write('f}r Anleitung '#155'33mHELP'#155'37m dr}cken!');
  143.     end;
  144.   end;
  145. end;
  146.  
  147. PROCEDURE handle_escseq(chars: str80);
  148. { wie handle_key, aber für die ESC-Sequenzen der Sondertasten }
  149. VAR i,page,page2: integer;
  150. begin
  151.   mainline;
  152.   if (chars='7~') then begin { F8: Seiten wegwerfen }
  153.     sleep; Write('Alle Seiten wegwerfen? ');
  154.     if ja_nein then begin
  155.       kill_list; redraw_list;
  156.       thispage := Nil; writepage(Nil,True);
  157.     end;
  158.     wakeup;
  159.   end else if (chars='8~') then begin { F9: Jobs killen }
  160.     queued := 0;
  161.     FOR i := 0 TO maxactive-1 DO BEGIN
  162.       activejobs[i].pg := 0;
  163.       sperren(i);
  164.     END;
  165.     redraw_queue(-1);
  166.   END ELSE IF chars='9~' THEN BEGIN { F10: VT.config lesen }
  167.     busy_pointer; getconfig;
  168.     normal_pointer;
  169.   END else if (chars='0~') then { F1 }
  170.     TV_display(2)
  171.   else if (chars='1~') then { F2 }
  172.     TV_display(1)
  173.   else if (chars='2~') then { F3 }
  174.     TV_display(0);
  175.   if (chars='?~') then begin { Help }
  176.     sleep; displayhelp; redraw_all; wakeup;
  177.     exit;
  178.   end;
  179.   { Cursor: Seitenliste durchblättern }
  180.   if pos(chars,'ABCDST')>0 then begin
  181.     mark_list(false);
  182.     if thispage<>Nil then begin
  183.       if (chars='A') then
  184.         if (thispage^.prev<>Nil) then
  185.           thispage := thispage^.prev;
  186.       if (chars='B') then
  187.         if (thispage^.next<>Nil) then
  188.           thispage := thispage^.next;
  189.       if (chars='C') then for i := 1 to qlen do
  190.         if (thispage^.next<>Nil) then
  191.           thispage := thispage^.next;
  192.       if (chars='D') then for i := 1 to qlen do
  193.         if (thispage^.prev<>Nil) then
  194.           thispage := thispage^.prev;
  195.       if chars='S' then
  196.         thispage := next_magazine(thispage);
  197.       if chars='T' then
  198.         thispage := prev_magazine(thispage);
  199.     end;
  200.     mark_list(true);
  201.     writepage(thispage,true);
  202.     exit;
  203.   end;
  204. end;
  205.  
  206. BEGIN  { Hauptprogramm }
  207.   { Eine Menge Variablen werden bereits in den Units, wo sie auch definiert }
  208.   { sind, initialisiert. }
  209.   get_args;   { u. a. Namen für Ausgabedatei holen }
  210.   AddExitServer(sysclean); sysinit(version);
  211.   init_CCT; { SAA 5246 initialisieren }
  212.   active := 0; FOR j := 0 TO maxactive-1 DO activejobs[j].pg := 0;
  213.   roundrobin := 0; testing := False; stop := False;
  214.   lastkey := #0;  eingabe := '';
  215.   cursoroff;
  216.   redraw_all;
  217.   REPEAT
  218.     GotoXY(2,queued+4+maxactive); Write(#155'37m',eingabe,#155'7m '#155'0m ');
  219.     IF (thispage=Nil) AND (root<>Nil) THEN BEGIN
  220.       thispage := root;
  221.       writepage(thispage,True);
  222.     END;
  223.     IF lastkey=#0 THEN
  224.       taste := readkey
  225.     ELSE BEGIN
  226.       taste := lastkey; lastkey := #0;
  227.     END;
  228.     IF taste=#155 THEN BEGIN { Sondertasten auswerten }
  229.       s := '';
  230.       REPEAT
  231.         ch := readkey; IF ch<>#0 THEN s := s + ch;
  232.       UNTIL ch = #0;
  233.       handle_escseq(s);
  234.     END ELSE IF taste<>#0 THEN
  235.       handle_key(taste)
  236.     ELSE BEGIN
  237.       Delay(2);  { Multitasking-freundlich! }
  238.       IF testing THEN test(True);
  239.       IF (queued+active=0) AND NOT testing THEN l := Wait(-1);
  240.       IF (active>0) AND (taste=#0) THEN attempt_input(roundrobin);
  241.       IF queued+active>0 THEN BEGIN handle_queue; handle_jobs; END;
  242.       active := 0;
  243.       FOR j := 0 TO maxactive-1 DO
  244.         IF (activejobs[j].pg>0) THEN Inc(active);
  245.       roundrobin := (roundrobin+1) MOD maxactive;
  246.     END;
  247.     stop := stop OR abbruch_test;
  248.   UNTIL stop;
  249.   SetStdIO(Nil); CloseConsole(Con);
  250.   kill_list; sysclean;
  251. END.
  252.  
  253.